home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PREVIEW / ORGFILES / WPREVIEW.PAS < prev    next >
Pascal/Delphi Source File  |  1995-11-12  |  58KB  |  1,932 lines
  1. Unit wPreview;
  2.  
  3. interface
  4.  
  5. uses
  6.   Forms, SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Dialogs, ExtCtrls, ShellApi, BTprint, StdCtrls, Buttons, DBFserver,
  8.   Menus, VBXCtrl, TrueBar;
  9.  
  10. const PrnInitFile='PrnInit.txt';
  11.       MaxLpTitles=20;     { Max jobs printing at one time }
  12.       MaxPrns=20;         { Max printers }
  13.       MaxQTypes=10;       { Max Defined Queues }
  14.       MaxFonts=10;        { Max Defined Fonts }
  15.       MaxPageLen=58;      { Max lines per page (text style printing) }
  16.             MaxPages=30;        { Max pages per report (if you want previewing) }
  17.       ScrnCanvasX=820;    { Image width and height for preview image box }
  18.       ScrnCanvasY=940;
  19.       ScrnRowHeight=900;  { Vertical height of canvas for tight
  20.                             Vertical spacing }
  21.             RefPixPerInchX=300; { Reference printer pixels per inch horizontal }
  22.             RefPixPerInchY=300; { Reference printer pixels per inch vertical }
  23.       RefAspectYdbl:double=300.0;  { Used in cmX() and cmY() }
  24.       RefAspectXdbl:double=300.0;
  25.       ScrnPixPerInchX=70; { GetDeviceCaps() returns 96, I prefer 70 }
  26.       ScrnPixPerInchY=70; { Calc by measuring your screen image and dividing
  27.                             into your screen densities: 640x480, 800x600 }
  28.       ScrollPixels=20;    { When viewing section of large BMP's, scroll 1/2" }
  29.       { following are passed to StartDoc() }
  30.       For8x11=false;  { Report designed for 8.5x11 paper size }
  31.       For14x11=true;  { Report designed for 14x11 paper size }
  32.             Dlm='|';        { Delimiter used by AddCommand(), can be more than
  33.                               one char if a conflict }
  34.  
  35. type
  36.     PrnInfo=Record
  37.         { It may be available but no selectable in the Printer Select window }
  38.         PrName:string[30];  { Printer name as it appears in win.ini }
  39.     PrPort:string[40];   { Lpt?, 1..3 }
  40.         Queue:string[30];      { Queue name as it appears in Network setup }
  41.       CanSelect:boolean;  { Will appear in Select Printer window }
  42.     PrType:integer;     { Printer Type, see PRNINIT.TXT, associates queues }
  43.         PrWide:Boolean;     { Wide carriage style printer? }
  44.     end;
  45.   LPMain=class(TObject)
  46.         public
  47.             LptPrinters:array [1..MaxPrns] of PrnInfo;
  48.       PrnCnt,AvailCnt,QueueCnt:integer;
  49.       AvailType:array [1..MaxPrns] of integer;
  50.       QueueType:array [1..MaxPrns,1..MaxQTypes] of integer;
  51.       AvailName,QueueName,QueueTitle:array [1..MaxPrns] of string[40];
  52.             AvailWide:array [1..MaxPrns] of boolean;
  53.       { fixed width fonts }
  54.       FontList:array [1..MaxFonts] of string[40]; { Over 5 are variable width }
  55.       { CurDest, WantsPreview set in Select Printer window }
  56.             CurDest:integer;       { Current hardcopy destination }
  57.       WantsPreview:boolean;  { Wants Report Preview }
  58.             LastHardCopy:integer;  { Last hardcopy printer selected }
  59.             procedure LoadPrinters(FromFile:string);
  60.       function  CurrentPrinterInfo:string;
  61.             procedure GetPrinterType(aPrinterName:string;var pType:integer;
  62.         pWideCarriage:boolean);
  63.             function  GetQueueNum(ForQueue:string):Integer;
  64.       { Capture sets: No Banner, No Form Feed, Binary Files (No Tab Expand) }
  65.             procedure Capture(PortNum:integer;ToQueue:string);
  66.             procedure EndCapture(PortNum:integer);
  67.     end;
  68.   TPreview = class(TForm)
  69.     Image1: TImage;
  70.     Panel1: TPanel;
  71.     Label1: TLabel;
  72.     Panel2: TPanel;
  73.     Label3: TLabel;
  74.     BitBtn6: TBitBtn;
  75.     BitBtn1: TBitBtn;
  76.     Button1: TButton;
  77.     Button2: TButton;
  78.     Button3: TButton;
  79.     Button4: TButton;
  80.     Label4: TLabel;
  81.     Edit1: TEdit;
  82.     PopupMenu1: TPopupMenu;
  83.     Close1: TMenuItem;
  84.     N1: TMenuItem;
  85.     FirstPg1: TMenuItem;
  86.     PreviousPg1: TMenuItem;
  87.     NextPg1: TMenuItem;
  88.     LastPg1: TMenuItem;
  89.     N2: TMenuItem;
  90.     PrintAll1: TMenuItem;
  91.     PrintPg1: TMenuItem;
  92.     Image2: TImage;
  93.     GoToPg1: TMenuItem;
  94.     N3: TMenuItem;
  95.     Barcode1: TBarcode;
  96.     Panel3: TPanel;
  97.     Label2: TLabel;
  98.     Label5: TLabel;
  99.     Label6: TLabel;
  100.     procedure FormCreate(Sender: TObject);
  101.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  102.     procedure BitBtn6Click(Sender: TObject);
  103.     procedure BitBtn1Click(Sender: TObject);
  104.     procedure Button3Click(Sender: TObject);
  105.     procedure Button4Click(Sender: TObject);
  106.     procedure Button2Click(Sender: TObject);
  107.     procedure Button1Click(Sender: TObject);
  108.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  109.     procedure Close1Click(Sender: TObject);
  110.     procedure FirstPg1Click(Sender: TObject);
  111.     procedure PreviousPg1Click(Sender: TObject);
  112.     procedure NextPg1Click(Sender: TObject);
  113.     procedure LastPg1Click(Sender: TObject);
  114.     procedure PrintAll1Click(Sender: TObject);
  115.     procedure PrintPg1Click(Sender: TObject);
  116.     procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
  117.       Shift: TShiftState; X, Y: Integer);
  118.     procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
  119.       Shift: TShiftState; X, Y: Integer);
  120.     procedure GoToPg1Click(Sender: TObject);
  121.     procedure FormActivate(Sender: TObject);
  122.   private
  123.     wCommands:array [1..MaxPages] of tstringlist;
  124.     ViewPageTot:integer;  { Internal Page Counter For Commands[] }
  125.     CurPage:integer;      { Current Page Being Displayed }
  126.     wCurDest:integer;     { Next three items set by Lpr before finishing }
  127.     wRpWide:boolean;
  128.         wShortTitle:string;
  129.     wPageTot:integer;
  130.     Zoomable,FitToScreen:boolean;
  131.     BigX,BigY:integer;
  132.     FirstTimeBig:boolean;
  133.     useLandScape:boolean;    { Set before calling PlayBackPage }
  134.         function  PlayBackPage(ToScreen:boolean;PageNum:integer):boolean;
  135.         procedure SaveCommands(toFile:string);
  136.     procedure SetButtons;
  137.         procedure ShowBigImage;
  138.         procedure LoadCommands(fromFile:string);
  139.   public
  140.         procedure ShowBluePrint(aCaption,TinyBMP,FullBMP:string);
  141.         procedure PrintBluePrint(FullBMP:string);
  142.         procedure PrintCommandFile(aLoadSpec:string);
  143.   end;
  144.   lpr=class(TObject)
  145.       private
  146.             Row,Col:Integer;        { Current printer row,col for TextStyle }
  147.             RpWide,FixedWidth:Boolean;      { Report width, true if greater than 80 }
  148.       RowHeight,ColWidth,Fixed10Width,Fixed12Width,Fixed8Width:integer;
  149.       AdjZeroX,AdjZeroY:double; {Used 0,0 offset, in centimeters}
  150.             Preview: TPreview;
  151.       aCanvas:TCanvas;        { Actual display surface }
  152.             NumOfCopies:Integer;    { Number of copies }
  153.             CurDest:integer;        { Current hardcopy destination }
  154.             CurFont:integer;        { Used in SetGDIFont }
  155.       Condensed:boolean;      { Use condensed print }
  156.       RowColStyle:boolean;    { Set type of text, set using SetTextStyle }
  157.             FromPreview:boolean;    { Used by StartDoc2 and Preview window }
  158.         useLandScape:boolean;   { Set in StartDoc }
  159.             Commands:array [1..MaxPages] of tstringlist;
  160.             ViewPageTot:integer;          { Used with Commands to track pages }
  161.             InsideCommand:boolean;  { Stop recursion of AddCommand() }
  162.       ScaleXby,ScaleYby:longint;
  163.       FromLoadToPrint:boolean; { Load an print a command file }
  164.             procedure StartDoc2(ToPreview,Over80Wide:boolean;
  165.               aBriefTitle:string);  { Only used by Preview window }
  166.           { Prints text to selected canvas: screen or printer }
  167.             procedure Wout(xpos,ypos:integer;aStr:string);
  168.                 { Use to change font and style to one of FontList[] items }
  169.             procedure setGDIfont(NewFont:string); { set by pxText() }
  170.           { The following is used to correct alignment,
  171.             base reference printer is 300 dpi,
  172.                     see RefAspectX and RefAspectY below }
  173.       procedure SetScaleXY;
  174.       procedure SetScaleXY70;
  175.  
  176.                 { Scale reference pixels to current canvas }
  177.       function  ScaleX(RefX:integer):integer;
  178.       function  ScaleY(RefY:integer):integer;
  179.                 { Easy way to lay out forms, use centimeters from top and left
  180.                     edge to position items, then print once on printer it is to be
  181.                     used on, add the adjustments to list in SetZeroXY() routine to
  182.                     correct 0,0 position, for pre-printed forms }
  183.       procedure SetZeroXY(aPrType:integer);
  184.         public
  185.             ShortTitle:string[70];
  186.             Line,Page,PGlen:integer;
  187.       WantsPreview:boolean;  { Wants report previewing }
  188.             WindowDest:boolean;    { Raster ops are going to a Window }
  189.       PrePrintedForm:boolean; { After SetDestination }
  190.       pr:TPrinter;        { Used when printing hardcopy }
  191.       { The following vars used to correct alignment when using the
  192.         Windows printing system, adjusted proportionally to reference printer
  193.         output }
  194.       RefAspectX,RefAspectY,PrnAspectY,PrnAspectX:integer;
  195.       CanvasWidth,CanvasHeight:integer;
  196.       Running,Abort:boolean;
  197.       CancelState:integer;
  198.       constructor Create;
  199.             procedure StartDoc(Over80Wide:boolean;aBriefTitle:string);
  200.             procedure StopDoc;
  201.              procedure SetCaption(toStr:string);
  202.             procedure SetDestination; { Call before StartDoc() }
  203.       procedure ForceToScreen;  { These two must be after SetDestination, }
  204.       procedure ForceToPrinter; { Before StartDoc, to override default dest. }
  205.         function  Cancel:integer; { 0-not running, 1-continue, 2-abort }
  206.             { Key print commands should start with AddCommand
  207.               and end with EndCommand to keep recursion from occuring }
  208.             procedure AddCommand(CommandStr:string);
  209.             procedure EndCommand;
  210.       procedure SetTextStyle(forText:boolean);
  211.  
  212.       { the following are used to emulate a line printer }
  213.             procedure TextFont(NewFont:string); { chng font for line printer style }
  214.             procedure Write(astr:string);
  215.             procedure WriteLn(astr:string);
  216.             procedure P(atrow,atcol:integer;astr:string);
  217.             procedure SetRowCol(toRow,toCol:integer);
  218.             function  pRow:integer;
  219.             function  pCol:integer;
  220.             procedure CrLf;
  221.             procedure Eject;  { used for both Text and Raster styles }
  222.             { converts designated chars to alternate types, for engineering }
  223.             function  SpecChars(istr:string):string;
  224.  
  225.       { the following are used for X,Y canvas-style printing, params are
  226.               in Centimeters, easy way to position items, translates Centimeters
  227.                 to Reference pixels, then passes to px???? commands }
  228.             procedure cmLine(left,top,width,height:double);
  229.             procedure cmBox(left,top,width,height:double;graylev:integer);
  230.             procedure cmText(left,top:double;uzfont,thetext:string);
  231.             procedure cmImage(IsColor:boolean;left,top:double;
  232.                                                 ScrnBMP,PrintBMP:string);
  233.             procedure cmBarCode(left,top,width,height:double;Text:string);
  234.  
  235.       { actual routines used for X,Y raster printing, params are
  236.               in current reference Pixels and use ScaleX and ScaleY to
  237.         convert to current canvas pixels, usually called by cm??? }
  238.             { aRect values are: left, top, width, height }
  239.             procedure pxLine(aRect:Trect);
  240.             procedure pxText(aPoint:TPoint;uzFont,TheText:string);
  241.             procedure pxImage(IsColor:boolean;aRect:Trect;ScrnBMP,PrintBMP:string);
  242.             procedure pxOrientation(newOrientation:TPrinterOrientation);
  243.             procedure pxBarCode(aRect:Trect;Text:string);
  244.             procedure pxBox(aRect:Trect;GrayLev:integer);
  245.             procedure pxTray(UseTray:integer);
  246.             procedure pxRaster(Left,Top,Width,Height,Density:integer;FileName:string);
  247.     end;
  248.  
  249. var lp:LPmain;  { Contains printer descriptions and setups }
  250.     { List of currently active printing windows or jobs in progress }
  251.         CurPrinting:array [1..MaxLpTitles] of string30; 
  252. procedure StartLinePrinter;  { Call in the MainForm's FormCreate method }
  253. procedure StopLinePrinter;   { Call in the MainForm's FormClose method }
  254. procedure DirectToPrinter(anEscSeq:string);
  255. function  cmX(Centimeters:double):integer; { Centimeters to ref. pixels }
  256. function  cmY(Centimeters:double):integer;
  257.  
  258. implementation
  259.  
  260. {$R *.DFM}
  261.  
  262. uses Commoncode, NWCaldef, NWconnec, NWPrint; { NW??? units from Apiary lib }
  263.  
  264. { WNetGetConnection>0 no queue attached, 0-Queue name returned in RemoteName }
  265. function  WNetGetConnection(LocalDev,RemoteName:Pchar;
  266.                                                         var RetSize:integer):integer;far;external 'USER';
  267.  
  268. function GetTitle(aStr:string):string;
  269. var ii:integer;
  270. begin
  271.   ii:=pos('::',upper(aStr));
  272.   result:=aStr;
  273.   if ii>0 then begin
  274.     result:=ltrim(trim(substr(aStr,ii+2,70)));
  275.   end;
  276.   ii:=pos(Dlm+Dlm,aStr);
  277.   if ii>10 then result:=substr(aStr,ii+2,70);
  278. end;
  279.  
  280. procedure TPreview.FormCreate(Sender: TObject);
  281. var ii:integer;
  282. begin
  283.   width:=627;
  284.   height:=413;
  285.   left:=0;
  286.   top:=0;
  287.     centerhoriz(self);
  288.     Gen.AddWin('Preview',self);
  289.   CurPage:=1;
  290.     image1.width:=ScrnCanvasX;
  291.   image1.height:=ScrnCanvasY;
  292.   panel1.width:=image1.width;
  293.     for ii:=1 to MaxPages do wCommands[ii]:=nil;
  294.   Zoomable:=false;
  295.   FitToScreen:=false;
  296.   useLandScape:=false;
  297. end;
  298.  
  299. procedure TPreview.FormClose(Sender: TObject; var Action: TCloseAction);
  300. var bool:boolean;
  301.     ii:integer;
  302. begin
  303.   bool:=true;
  304.   if pin('FORMAT',upper(caption)) then begin
  305.     bool:=YesNoBox('Close Preview Window During Formatting?');
  306.   end;
  307.   if bool then begin
  308.       for ii:=1 to wPageTot do begin
  309.           if wCommands[ii]<>nil then wCommands[ii].free;
  310.         end;
  311.       if Zoomable then begin
  312.         Gen.InBluePrint:=false;
  313.         Gen.FullBP.free;  { free memory }
  314.         Gen.FullBP:=TBitMap.Create;
  315.         Gen.TinyBP.free;  { free memory }
  316.       Gen.TinyBP:=TBitMap.Create;
  317.       end;
  318.         Gen.ReleaseWin(self);
  319.       action:=caFree;
  320.   end;
  321. end;
  322.  
  323. procedure Lpr.Wout(xpos,ypos:integer;aStr:string);
  324. var ii,jj,orgx:integer;
  325.     tt:string[20];
  326. begin
  327.   { xpos, ypos should be in canvas pixels }
  328.   jj:=length(astr);
  329.   if jj>0 then begin
  330.     with aCanvas do begin
  331.       brush.style:=bsClear;
  332.       if FixedWidth then begin
  333.         if not RowColStyle then begin
  334.           if WindowDest then begin
  335.             ColWidth:=Fixed12Width;
  336.             if font.size=10 then ColWidth:=Fixed10width;
  337.             if font.size=8 then ColWidth:=Fixed8width;
  338.           end else begin
  339.             ColWidth:=Colwidth-1;
  340.             if font.size=10 then ColWidth:=Colwidth-1;
  341.             if font.size=8 then ColWidth:=Colwidth;
  342.           end;
  343.         end;
  344.         orgx:=xpos;
  345.         { adjust text spacing so a full will fit within the canvas width }
  346.         for ii:=1 to jj do begin
  347.           tt:=copy(astr,ii,1);
  348.           xpos:=orgx+(ii-1)*ColWidth;
  349.           textout(xpos,ypos,tt);
  350.           { Corporate Mono won't produce underlines, have to use Courier }
  351.           if (fsUnderline in font.style) and (font.name=lp.FontList[2]) then begin
  352.             font.name:=lp.FontList[1];
  353.             textout(xpos,ypos,'_');
  354.             font.name:=lp.FontList[2];
  355.           end;
  356.         end;
  357.       end else begin
  358.         textout(xpos,ypos,astr);
  359.       end;
  360.     end;
  361.   end;
  362. end;
  363.  
  364. procedure TPreview.PrintBluePrint(FullBMP:string);
  365. var tlp:TPrinter;
  366.     PrintBP:TBitmap;
  367.     tcanvas:trect;
  368.     ii,jj:integer;
  369.     tt:string;
  370. begin
  371.   caption:='Print B/P';
  372.   windowstate:=wsMinimized;
  373.   tlp:=TPrinter.create;
  374.   tlp.orientation:=poLandScape;
  375.   tlp.printerindex:=lp.curdest-1;
  376.   tlp.begindoc;
  377.   PrintBP:=tbitmap.create;
  378.   PrintBP.loadfromfile(FullBMP);
  379.   tlp.fCanvas.copyrect(tlp.fCanvas.cliprect,PrintBP.canvas,
  380.       PrintBP.canvas.cliprect);
  381.   tlp.enddoc;
  382.   tlp.destroy;
  383.   PrintBp.free;
  384.   close;
  385. end;
  386.  
  387. procedure Lpr.SetTextStyle(forText:boolean);
  388. begin
  389.     if WantsPreview then begin
  390.     if forText<>RowColStyle then
  391.       AddCommand(' 5'+Dlm+iifs(forText,'TRUE','FALSE'));
  392.   end;
  393.   RowColStyle:=forText;
  394.   EndCommand;
  395. end;
  396.  
  397. procedure Lpr.setGDIfont(NewFont:string);
  398. var ii,jj,OrgFont:integer;
  399.     tstyle:tfontstyles;
  400. begin
  401.   if not empty(NewFont) then begin
  402.     OrgFont:=CurFont;
  403.     with aCanvas do begin
  404.       tstyle:=font.style;
  405.       { when changing font type, must use style '1:12b', where '1:' is style }
  406.       if pin(':',NewFont) then begin
  407.         jj:=pos(':',NewFont);
  408.         if CurFont=0 then CurFont:=2;  { default font type }
  409.         if jj>1 then begin
  410.           ii:=procint(copy(NewFont,1,jj));
  411.           NewFont:=copy(NewFont,jj+1,35);
  412.             if (ii>0) and (ii<=MaxFonts) then begin
  413.               if not empty(lp.FontList[ii]) then CurFont:=ii
  414.             else begin
  415.               if ii<6 then CurFont:=1 else Curfont:=6;
  416.             end;
  417.             end;
  418.         end;
  419.         if orgfont>0 then begin
  420.           if CurFont<>orgfont then begin
  421.             font.name:=lp.FontList[CurFont];
  422.           end;
  423.         end else font.name:=lp.FontList[CurFont];
  424.       end;
  425.       FixedWidth:=(CurFont<6);
  426.       if not WindowDest then begin
  427.           if upin('Generic',lp.LptPrinters[CurDest].PrName) then begin
  428.           { cannot condense text, must layout to fit page as is }
  429.           CurFont:=1;  { Courier }
  430.           font.name:=lp.FontList[CurFont];
  431.           FixedWidth:=false;  { just print as is in wOut() }
  432.         end;
  433.       end;
  434.       { if change size, must also reset style }
  435.       if procint(NewFont)>0 then begin
  436.         font.size:=procint(NewFont);
  437.         font.color:=clBlack;
  438.           tstyle:=[];
  439.       end;
  440.       if pin('B',upper(NewFont)) then begin
  441.         Include(tstyle,fsbold);
  442.         if CurFont=2 then begin
  443.           CurFont:=3;
  444.             font.name:=lp.FontList[CurFont];
  445.         end;
  446.       end;
  447.       if pin('U',upper(NewFont)) then Include(tstyle,fsUnderline);
  448.       if pin('I',upper(NewFont)) then Include(tstyle,fsItalic);
  449.       { set back to normal }
  450.       if pin('N',upper(NewFont)) then begin
  451.         if CurFont=3 then begin  { Corporate Mono Bold, back to normal }
  452.           CurFont:=2;
  453.             font.name:=lp.FontList[CurFont];
  454.         end;
  455.           tstyle:=[];
  456.       end;
  457.       font.style:=tstyle;
  458.       if WindowDest then RowHeight:=ScrnRowHeight div 60
  459.       else RowHeight:=CanvasHeight div 60;
  460.       if CurFont<6 then begin
  461.         if WindowDest then begin
  462.             Fixed12Width:=((CanvasWidth-25) div 80)+1;
  463.             Fixed10Width:=(CanvasWidth-25) div 104;
  464.             Fixed8Width:=(CanvasWidth-25) div 132;
  465.         end else begin
  466.             Fixed12Width:=CanvasWidth div 80;
  467.             Fixed10Width:=CanvasWidth div 104;
  468.             Fixed8Width:=CanvasWidth div 132;
  469.         end;
  470.       end;
  471.       ColWidth:=CanvasWidth div (80+1);  { 12 pt }
  472.          if font.size=8 then ColWidth:=CanvasWidth div (132+1);
  473.          if font.size=10 then ColWidth:=CanvasWidth div (104+1);
  474.     end;
  475.   end;
  476. end;
  477.  
  478. procedure Lpr.SetScaleXY;
  479. var t1,t2:longint;
  480. begin
  481.   CanvasWidth:=acanvas.cliprect.right;
  482.   CanvasHeight:=acanvas.cliprect.bottom;
  483.   RefAspectX:=RefPixPerInchX;
  484.   RefAspectY:=RefPixPerInchY;
  485.     PrnAspectX:=GetDeviceCaps(acanvas.handle,LOGPIXELSX);
  486.   PrnAspectY:=GetDeviceCaps(acanvas.handle,LOGPIXELSY);
  487.   { for Screen is 96, squeeze a little tighter }
  488.   if WindowDest then begin
  489.     PrnAspectY:=PrnAspectY-4;
  490.   end;
  491.   { ScaleXby and ScaleYby used to adjust reference pixels to
  492.     actual pixels }
  493.   t1:=PrnAspectX;
  494.   t2:=RefAspectX;
  495.   ScaleXby:=(t1*100) div t2;
  496.   t1:=PrnAspectY;
  497.   t2:=RefAspectY;
  498.   ScaleYby:=(t1*100) div t2;
  499. end;
  500.  
  501. procedure Lpr.SetScaleXY70;
  502. var t1,t2:longint;
  503. begin
  504.   CanvasWidth:=acanvas.cliprect.right;
  505.   CanvasHeight:=acanvas.cliprect.bottom;
  506.   RefAspectX:=RefPixPerInchX;
  507.   RefAspectY:=RefPixPerInchY;
  508.   if WindowDest then begin
  509.       PrnAspectX:=ScrnPixPerInchX;
  510.       PrnAspectY:=ScrnPixPerInchX;
  511.   end else begin
  512.       PrnAspectX:=GetDeviceCaps(acanvas.handle,LOGPIXELSX);
  513.       PrnAspectY:=GetDeviceCaps(acanvas.handle,LOGPIXELSY);
  514.     end;
  515.   { ScaleXby and ScaleYby used to adjust reference pixels to
  516.     actual pixels }
  517.   t1:=PrnAspectX;
  518.   t2:=RefAspectX;
  519.   ScaleXby:=(t1*100) div t2;
  520.   t1:=PrnAspectY;
  521.   t2:=RefAspectY;
  522.   ScaleYby:=(t1*100) div t2;
  523. end;
  524.  
  525. function  Lpr.ScaleX(RefX:integer):integer;
  526. var longx:longint;
  527. begin
  528.   longx:=RefX;
  529.   Result:=(longx*ScaleXby) div 100;
  530. end;
  531.  
  532. function  Lpr.ScaleY(RefY:integer):integer;
  533. var longy:longint;
  534. begin
  535.   longy:=RefY;
  536.   Result:=(longy*ScaleYby) div 100;
  537. end;
  538.  
  539. constructor lpr.Create;
  540. var ii:integer;
  541. begin
  542.   inherited create;
  543.   Abort:=false;
  544.   Running:=false;
  545.   Preview:=nil;
  546.   AdjZeroX:=0.0;
  547.   AdjZeroY:=0.0;
  548.     FromPreview:=false;
  549.   WantsPreview:=false;
  550.   WindowDest:=false;
  551.   PrePrintedForm:=false;
  552.     for ii:=1 to MaxPages do Commands[ii]:=nil;
  553. end;
  554.  
  555. function  LPmain.CurrentPrinterInfo:string;
  556. begin
  557.   result:='';
  558.   if lp.CurDest>0 then begin
  559.       with lp.LptPrinters[lp.curdest] do begin
  560.       result:=trim(Prname)+' ('+iifs(empty(Queue),PrPort,Queue)+')';
  561.       end;
  562.   end;
  563. end;
  564.  
  565. procedure LPmain.GetPrinterType(aPrinterName:string;var pType:integer;
  566.   pWideCarriage:boolean);
  567. var ii:integer;
  568.     tt,tt2:string;
  569. begin
  570.   pType:=0;
  571.   pWideCarriage:=false;
  572.     with lp do begin
  573.       if AvailCnt>0 then begin
  574.           tt:=upper(aPrinterName);
  575.           for ii:=1 to AvailCnt do begin
  576.               tt2:=upper(AvailName[ii]);
  577.                 if tt=tt2 then begin
  578.                   pType:=AvailType[ii];
  579.           pWideCarriage:=AvailWide[ii];
  580.                     break;
  581.                 end;
  582.             end;
  583.         end;
  584.     end;
  585. end;
  586.  
  587. function LPmain.GetQueueNum(ForQueue:string):Integer;
  588. var ii:integer;
  589.     tt,tt2:string;
  590. begin
  591.   result:=0;
  592.     with lp do begin
  593.       if QueueCnt>0 then begin
  594.           tt:=upper(ForQueue);
  595.           for ii:=1 to QueueCnt do begin
  596.               tt2:=upper(QueueName[ii]);
  597.                 if tt=tt2 then begin
  598.                   result:=ii;
  599.                     break;
  600.                 end;
  601.             end;
  602.         end;
  603.     end;
  604. end;
  605.  
  606. procedure Lpr.SetZeroXY(aPrType:integer);
  607. begin
  608.   { Adjust origin for each printer for PrePrintedForm's }
  609.   AdjZeroX:=0.0;
  610.   AdjZeroY:=0.0;
  611.   if PrePrintedForm then begin
  612.     case aPrType of
  613.       5,6,7,8,13:begin  { LaserJet's }
  614.         AdjZeroX:=-0.7;
  615.         AdjZeroY:=-0.95;
  616.       end;
  617.       2,3,4,12:begin  { Canon BJ-200's }
  618.         AdjZeroX:=-0.8;
  619.         AdjZeroY:=-0.65;
  620.       end;
  621.       10,11:begin    { HP DeskJet's }
  622.         AdjZeroX:=0.0;
  623.         AdjZeroY:=0.0;
  624.       end;
  625.     end;
  626.   end;
  627. end;
  628.  
  629. procedure LPmain.LoadPrinters(FromFile:string);
  630. var tt,tt2,q1,q2,q3:string;
  631.         tparscnt,ii,jj,kk:integer;
  632.         plist:tstringlist;
  633.     tp1,tp2:pchar;
  634.     tpars:array [1..MaxPars] of string135;
  635.         pr:TPrinter;
  636. begin
  637.     pr:=TPrinter.create;
  638.   plist:=tstringlist.create;
  639.   plist.LoadFromFile(FromFile);
  640.     { setup printer and queue types first }
  641.     AvailCnt:=0;
  642.     QueueCnt:=0;
  643.     for ii:=1 to MaxPrns do begin
  644.         AvailType[ii]:=0;
  645.         AvailName[ii]:='';
  646.         AvailWide[ii]:=false;
  647.         QueueName[ii]:='';
  648.         QueueTitle[ii]:='';
  649.     { -1 so it will ignore unknown printers which have PrType=0 }
  650.         for jj:=1 to MaxQTypes do QueueType[ii][jj]:=-1;
  651.     with LptPrinters[ii] do begin
  652.       PrName:='';
  653.       PrPort:='';
  654.             PrType:=0;
  655.       CanSelect:=True;
  656.       PrWide:=False;
  657.       Queue:='';
  658.     end;
  659.     end;
  660.     for ii:=0 to plist.count-1 do begin
  661.       if pos('pp:',plist[ii])=1 then begin
  662.           split(plist[ii],':',tpars,tparscnt);
  663.             pp(AvailCnt);
  664.             AvailType[AvailCnt]:=procint(tpars[2]);
  665.             AvailName[AvailCnt]:=trim(tpars[3]);
  666.             AvailWide[AvailCnt]:=pin('WIDE',upper(plist[ii]));
  667.             { always make the generice printer wide carriage }
  668.             if pin('GENERIC',upper(tpars[3])) then AvailWide[AvailCnt]:=true;
  669.         end;
  670.       if pos('qq:',plist[ii])=1 then begin
  671.           split(plist[ii],':',tpars,tparscnt);
  672.             pp(QueueCnt);
  673.             QueueName[QueueCnt]:=upper(trim(tpars[2]));
  674.             QueueTitle[QueueCnt]:=trim(tpars[3]);
  675.       split(tpars[4],',',tpars,tparscnt);
  676.       if tparscnt>MaxQTypes then begin
  677.         OKBox('Too Many Printers Defined For Queue '+QueueName[QueueCnt]);
  678.         tparscnt:=MaxQtypes;
  679.       end;
  680.             for jj:=1 to tparscnt do
  681.         QueueType[QueueCnt][jj]:=procint(tpars[jj]);
  682.         end;
  683.     end;
  684.   PrnCnt:=0;
  685.   { findout which Queues are attached to the 3 lpt ports }
  686.   q1:='';
  687.   q2:='';
  688.   q3:='';
  689.   tp1:=stralloc(60);
  690.   tp2:=stralloc(60);
  691.   strpcopy(tp1,'LPT1');
  692.   strpcopy(tp2,'');
  693.   kk:=58;  { set tp2 buffer size }
  694.   jj:=WNetGetConnection(tp1,tp2,kk);
  695.   if jj=0 then q1:=upper(strpas(tp2));
  696.   strpcopy(tp1,'LPT2');
  697.   strpcopy(tp2,'');
  698.   jj:=WNetGetConnection(tp1,tp2,kk);
  699.   if jj=0 then q2:=upper(strpas(tp2));
  700.   strpcopy(tp1,'LPT3');
  701.   strpcopy(tp2,'');
  702.   jj:=WNetGetConnection(tp1,tp2,kk);
  703.   if jj=0 then q3:=upper(strpas(tp2));
  704.     if pr.printers.count>0 then begin
  705.       for ii:=0 to pr.printers.count-1 do begin
  706.       split(pr.printers[ii],' on ',tpars,tparscnt);
  707.       { skip printer server printers and Publisher Rendering System PUB }
  708.       if PrnCnt<MaxPrns then begin
  709.         pp(PrnCnt);
  710.         with LptPrinters[PrnCnt] do begin
  711.           PrName:=trim(tpars[1]);
  712.           tt2:=PrName;
  713.           jj:=pos('(',tt2);
  714.           if jj>0 then tt2:=trim(copy(tt2,1,jj-1));
  715.           GetPrinterType(tt2,PrType,PrWide);
  716.           PrPort:=upper(tpars[2]);
  717.           CanSelect:=True;
  718.           { Ignore Print Server Printers, and MSPub Rendering Entry PUB: }
  719.           { i.e. Jeff's Shared LaserJeft }
  720.               if upin('SHARED',tpars[1]) or upin('PUB',tpars[2]) then begin
  721.                 CanSelect:=false;
  722.               end;
  723.           if (PrType=0) and (procint(PrPort)>0) and (CanSelect) then
  724.             Okbox('Need To Add '+Prname+' To '+PrnInitFile);
  725.           Queue:='';
  726.           if procint(PrPort)=1 then Queue:=q1;
  727.           if procint(PrPort)=2 then Queue:=q2;
  728.           if procint(PrPort)=3 then Queue:=q3;
  729.                     jj:=GetQueueNum(Queue);
  730.                     { Check Queue printer type matches Windows setup }
  731.                     if jj>0 then begin
  732.                         for kk:=1 to MaxQTypes do begin
  733.                             Queue:='';
  734.                             if (PrType>0) and (PrType=QueueType[jj][kk]) then begin
  735.                                 Queue:=upper(QueueName[jj]);
  736.                                 break;
  737.                             end;
  738.                         end;
  739.                     end else Queue:='';
  740.         end;
  741.       end;
  742.         end;
  743.     end;
  744.   { final result of LastHardCopy destination saved by StopLinePrinter }
  745.   tt:=GetProgIni('Printers','WantsPreview');
  746.   if tt='1' then WantsPreview:=true;
  747.   tt:=GetProgIni('Printers','LastHardCopy');
  748.   LastHardCopy:=procint(tt);
  749.   CurDest:=LastHardCopy;
  750.   if (CurDest<1) or (CurDest>lp.PrnCnt) then CurDest:=pr.printerindex+1
  751.   else begin
  752.       for ii:=1 to lp.Prncnt do
  753.             LptPrinters[ii].Queue:=GetProgIni('Printers',
  754.       lp.LptPrinters[ii].PrName);
  755.     Capture(procint(LptPrinters[CurDest].PrPort),
  756.       LptPrinters[CurDest].Queue);
  757.   end;
  758.   strdispose(tp1);
  759.   strdispose(tp2);
  760.     pr.free;
  761.   plist.free;
  762. end;
  763.  
  764. procedure Lpr.Write(astr:string);
  765. begin
  766.   p(Line,Pcol,astr);
  767. end;
  768.  
  769. procedure Lpr.WriteLn(astr:string);
  770. begin
  771.   p(line,pCol,astr);
  772.   Col:=0;
  773.   pp(line);
  774. end;
  775.  
  776. procedure Lpr.P(atrow,atcol:integer;astr:string);
  777. var OverPGlen:boolean;
  778. begin
  779.   if Abort then Exit;
  780.     if WantsPreview then AddCommand(' 1'+Dlm+
  781.       inttostr(atrow)+Dlm+inttostr(atcol)+Dlm+astr);
  782.   OverPGlen:=false;
  783.   if atrow<Row then begin
  784.     Eject;
  785.     pp(page);
  786.   end;
  787.   if atrow>(PgLen+2) then begin
  788.     Eject;
  789.       OverPGlen:=true;
  790.     pp(page);
  791.   end;
  792.   Row:=atRow;
  793.   Col:=atcol;
  794.   if length(astr)>0 then begin
  795.     if not WantsPreview then begin
  796.       ColWidth:=iifi(Condensed,Fixed8Width,Fixed12Width);
  797.       wout(col*ColWidth,row*RowHeight,astr);
  798.     end;
  799.     Col:=Col+length(astr);
  800.   end;
  801.   if OverPGlen then begin { must not reset row and col till after print }
  802.     row:=0;
  803.     col:=0;
  804.     line:=-1;
  805.   end;
  806.     EndCommand;
  807. end;
  808.  
  809. procedure Lpr.SetDestination;
  810. { Set printer options using LPmain info.
  811.     Should be called before StartDoc(), but only once, when
  812.   the choice to print has been made, not inside a loop of any kind
  813.     because the printer destination might be changed by some other event }
  814. begin
  815.     NumOfCopies:=1;
  816.     CurDest:=lp.CurDest;
  817.   WantsPreview:=lp.WantsPreview;
  818.   WindowDest:=WantsPreview;
  819.     RpWide:=Lp.LptPrinters[curdest].PrWide;
  820. end;
  821.  
  822. procedure Lpr.StartDoc2(ToPreview,Over80Wide:boolean;
  823.                                                 aBriefTitle:string);
  824. begin
  825.   FromPreview:=ToPreview;
  826.     StartDoc(Over80Wide,aBriefTitle);
  827. end;
  828.  
  829. procedure Lpr.StartDoc(Over80Wide:boolean;aBriefTitle:string);
  830. var ii:integer;
  831.     Use70,paper8x11:boolean;
  832.     tt,tt2:string;
  833. begin
  834.     ShortTitle:=aBriefTitle;
  835.   for ii:=1 to MaxLpTitles do begin
  836.       if empty(CurPrinting[ii]) then begin
  837.           CurPrinting[ii]:=ShortTitle;
  838.             break;
  839.         end;
  840.     end;
  841.   Abort:=false;
  842.   Running:=true;
  843.   RpWide:=Over80Wide;
  844.   PgLen:=MaxPageLen;
  845.     NumOfCopies:=1;
  846.   { page starts at 0,0 }
  847.   Row:=0;
  848.   Col:=0;
  849.   Page:=1;
  850.   Line:=0;
  851.   RowHeight:=1;
  852.   ColWidth:=1;
  853.   Use70:=false;
  854.   FromLoadToPrint:=false;
  855.     Fixed12Width:=0;
  856.   Fixed8Width:=0;
  857.   CurFont:=0;
  858.     ViewPageTot:=1;
  859.     Commands[ViewPageTot]:=tstringlist.create;
  860.     pr:=TPrinter.create;
  861.     InsideCommand:=false;
  862.     if CurDest>0 then pr.printerindex:=CurDest-1;
  863.   ShortTitle:=GetTitle(aBrieftitle);
  864.   ii:=pos('::',aBriefTitle);
  865.     { wants accurate reference to units screen measurements }
  866.   Use70:=pin('70::',copy(aBriefTitle,1,ii));
  867.   if not FromPreview then begin
  868.       preview:=tpreview.create(application);
  869.         preview.caption:='Formatting '+ShortTitle;
  870.       preview.ViewPageTot:=1;
  871.       preview.panel1.width:=preview.image1.width;
  872.     Commands[ViewPageTot].insert(0,' 1'+Dlm+' 0'+Dlm+
  873.           iifs(RpWide,'for14x11','for8x11')+Dlm+Dlm+aBriefTitle);
  874.   end;
  875.     if WantsPreview then begin
  876.         WindowDest:=true;
  877.         SetZeroXY(0);
  878.         aCanvas:=Preview.image1.Canvas;
  879.     end else begin
  880.       if FromPreview then begin
  881.           if not WindowDest then begin
  882.           {if useLandScape then pr.Orientation:=poLandScape;}
  883.               SetZeroXY(lp.LptPrinters[lp.CurDest].PrType);
  884.                 pr.begindoc;
  885.           pr.fcanvas.brush.style:=bsSolid;
  886.         pr.fcanvas.brush.color:=clWhite;
  887.         pr.fcanvas.fillrect(pr.fcanvas.cliprect);
  888.                 aCanvas:=pr.fcanvas;
  889.             end;
  890.         end else begin
  891.             WindowDest:=false;
  892.             preview.caption:='Formatting '+aBriefTitle;
  893.       {if useLandScape then pr.Orientation:=poLandScape;}
  894.             SetZeroXY(lp.LptPrinters[lp.CurDest].PrType);
  895.             pr.begindoc;
  896.       pr.fcanvas.brush.style:=bsSolid;
  897.       pr.fcanvas.brush.color:=clWhite;
  898.       pr.fcanvas.fillrect(pr.fcanvas.cliprect);
  899.             aCanvas:=pr.fcanvas;
  900.         end;
  901.     end;
  902.     with aCanvas do begin
  903.         if not WindowDest then begin
  904.       paper8x11:=not Lp.LptPrinters[CurDest].PrWide;
  905.         end else begin
  906.       paper8x11:=true;
  907.         end;
  908.     if Use70 and WindowDest then SetScaleXY70 else SetScaleXY;
  909.     SetTextStyle(true);  { start in text style }
  910.         with font do begin
  911.       SetGDIFont('2:12');
  912.       Condensed:=false;
  913.       if WindowDest then SetGDIFont('2:10');
  914.             if RpWide And paper8x11 then begin
  915.         Condensed:=true;
  916.           SetGDIFont('2:8');
  917.             end;
  918.         end;
  919.     end;
  920. end;
  921.  
  922. procedure Lpr.StopDoc;
  923. var ii:integer;
  924. begin
  925.   for ii:=1 to MaxLpTitles do begin
  926.       if ShortTitle=CurPrinting[ii] then begin
  927.           CurPrinting[ii]:='';
  928.             break;
  929.         end;
  930.     end;
  931.     if not WindowDest then begin
  932.         preview.caption:='Printing '+ShortTitle;
  933.     if FromLoadToPrint then begin
  934.     { special case when commands loaded from file }
  935.         pr.Abort; { close current printer device, handled by PlayBackPage }
  936.       preview.wCurDest:=CurDest;
  937.       preview.wPageTot:=ViewPageTot;
  938.       for ii:=1 to ViewPageTot do begin
  939.         preview.wCommands[ii]:=tstringlist.create;
  940.         preview.wCommands[ii].assign(Commands[ii]);
  941.         Commands[ii].free;
  942.       end;
  943.       { keep track of StartDoc() settings }
  944.       preview.wRpWide:=RpWide;
  945.       preview.wShortTitle:=ShortTitle;
  946.       preview.playbackPage(false,0);
  947.     end else pr.EndDoc;
  948.     preview.close;
  949.     end;
  950.     pr.free;
  951.   Running:=false;
  952.   if WantsPreview then begin
  953.     preview.wCurDest:=CurDest;
  954.     preview.wPageTot:=ViewPageTot;
  955.         for ii:=1 to ViewPageTot do begin
  956.       preview.wCommands[ii]:=tstringlist.create;
  957.           preview.wCommands[ii].assign(Commands[ii]);
  958.             Commands[ii].free;
  959.         end;
  960.         { keep track of StartDoc() settings }
  961.     preview.wRpWide:=RpWide;
  962.         preview.wShortTitle:=ShortTitle;
  963.     preview.CurPage:=1;
  964.     preview.PlayBackPage(true,1);
  965.     preview.setbuttons;
  966.   end;
  967. end;
  968.  
  969. procedure Lpr.SetRowCol(toRow,toCol:integer);
  970. begin
  971.   if Abort then Exit;
  972.     if WantsPreview then AddCommand(' 2'+Dlm+inttostr(torow)+Dlm+
  973.     inttostr(tocol));
  974.   Col:=toCol;
  975.   Row:=toRow;
  976.     EndCommand;
  977. end;
  978.  
  979. procedure Lpr.CrLf;
  980. begin
  981.   if Abort then Exit;
  982.     if WantsPreview then AddCommand(' 3');
  983.     pp(Row);
  984.   Col:=0;
  985.     EndCommand;
  986. end;
  987.  
  988. procedure Lpr.Eject;
  989. begin
  990.   if Abort then Exit;
  991.     if not WindowDest then pr.newpage
  992.   else begin
  993.         if ViewPageTot<MaxPages then begin
  994.             pp(ViewPageTot);
  995.       Commands[ViewPageTot]:=tstringlist.create;
  996.     end;
  997.   end;
  998.   Row:=0;
  999.   Line:=0;
  1000.   Col:=0;
  1001. end;
  1002.  
  1003. function Lpr.pRow:integer;
  1004. begin
  1005.   Result:=Row;
  1006. end;
  1007.  
  1008. function Lpr.pCol:integer;
  1009. begin
  1010.     Result:=Col;
  1011. end;
  1012.  
  1013. function Lpr.SpecChars(istr:string):string;
  1014. var ii,tcnt:integer;
  1015.     tst:string[10];  { special chars ~ ` ^ }
  1016.         tt:string[3];
  1017.         tarr:array [1..30] of string135;
  1018. begin
  1019.   ii:=pos('+/-',istr);
  1020.   if ii>0 then begin
  1021.     tcnt:=0;
  1022.     split(istr,'+/-',tarr,tcnt);
  1023.     istr:=unsplit(tarr,'~',tcnt);
  1024.   end;
  1025.   for ii:=1 to length(istr) do begin
  1026.     tst:=Copy(istr,ii,1);
  1027.     if tst='`' then begin  { degree }
  1028.       istr[ii]:=chr(176);
  1029.     End Else
  1030.     Begin
  1031.       if tst='~' then begin  { +/- symbol }
  1032.         istr[ii]:=chr(177);
  1033.       End Else
  1034.       Begin
  1035.         if tst='^' then begin  { Greek theta character }
  1036.           istr[ii]:=chr(216);
  1037.         End Else
  1038.         Begin
  1039.           if tst='_' then begin  { replace underscores with spaces }
  1040.             istr[ii]:=' ';
  1041.           End;
  1042.         End;
  1043.       End;
  1044.     End;
  1045.   End;
  1046.   Result:=istr;
  1047. end;
  1048.  
  1049. procedure Lpr.pxTray(usetray:integer);
  1050. var p1,r1:integer;
  1051.     prt:string[20];
  1052. begin
  1053.   if Abort then Exit;
  1054.     if WantsPreview then AddCommand('28'+Dlm+inttostr(usetray))
  1055.   else begin
  1056.       { not written yet }
  1057.   end;
  1058.     EndCommand;
  1059. end;
  1060.  
  1061. function cmX(Centimeters:double):integer; { centimeters to ref. pixels }
  1062. var ii:integer;
  1063. begin
  1064.   ii:=procint(strd((Centimeters*RefAspectXdbl)/2.54,0));
  1065.   result:=ii;
  1066. end;
  1067.  
  1068. function cmY(Centimeters:double):integer; { centimeters to ref. pixels }
  1069. var ii:integer;
  1070. begin
  1071.   ii:=procint(strd((Centimeters*RefAspectYdbl)/2.54,0));
  1072.   result:=ii;
  1073. end;
  1074.  
  1075. procedure Lpr.cmLine(left,top,width,height:double);
  1076. begin
  1077.     pxLine(Rect(cmX(left+AdjZeroX),cmY(top+AdjZeroY),cmX(width),cmY(height)));
  1078. end;
  1079.  
  1080. procedure Lpr.cmBox(left,top,width,height:double;graylev:integer);
  1081. begin
  1082.     pxBox(Rect(cmX(left+AdjZeroX),cmY(top+AdjZeroY),cmX(width),
  1083.     cmY(height)),GrayLev);
  1084. end;
  1085.  
  1086. procedure Lpr.cmText(left,top:double;uzfont,thetext:string);
  1087. begin
  1088.     pxText(Point(cmX(left+AdjZeroX),cmY(top+AdjZeroY)),uzFont,TheText);
  1089. end;
  1090.  
  1091. procedure Lpr.cmImage(IsColor:boolean;left,top:double;ScrnBMP,PrintBMP:string);
  1092. begin
  1093.     pxImage(IsColor,Rect(cmX(left+AdjZeroX),cmY(top+AdjZeroY),0,0),
  1094.     ScrnBMP,PrintBMP);
  1095. end;
  1096.  
  1097. procedure Lpr.cmBarCode(left,top,width,height:double;Text:string);
  1098. begin
  1099.     pxBarCode(Rect(cmX(left+AdjZeroX),cmY(top+AdjZeroY),cmX(width),
  1100.     cmY(height)),Text);
  1101. end;
  1102.  
  1103. procedure Lpr.pxRaster(Left,Top,Width,Height,Density:integer;FileName:string);
  1104. var tb,tb2:TBitmap;
  1105.     map:tstringlist;
  1106.     tt:string;
  1107.     ii,jj,kk,zz,ll,ypos,xpos,tox,toy,shift:integer;
  1108.     fromrect,torect:trect;
  1109.     lcolor:longint;
  1110. begin
  1111.   if Abort then Exit;
  1112.   if WantsPreview then AddCommand('29'+Dlm+
  1113.     ltrim(stri(left,5))+Dlm+ltrim(stri(top,5))+Dlm+
  1114.     ltrim(stri(width,5))+Dlm+ltrim(stri(height,5))+Dlm+
  1115.     ltrim(stri(density,5))+Dlm+FileName)
  1116.   else begin
  1117.     if not FileExists(FileName) then begin
  1118.       OKbox('pxRaster, File Not Found: '+FileName);
  1119.       exit;
  1120.     end;
  1121.     tb:=tbitmap.create;
  1122.     tb2:=tbitmap.create;
  1123.     tb.canvas.brush.style:=bsSolid;
  1124.     tb.canvas.brush.color:=clWhite;
  1125.     tb.canvas.fillrect(tb.canvas.cliprect);
  1126.     map:=tstringlist.create;
  1127.     map.loadfromfile(FileName);
  1128.     tb.height:=300;
  1129.     tb.width:=300;
  1130.     tb2.height:=ScaleY(height);
  1131.     tb2.width:=ScaleX(width);
  1132.     shift:=1;
  1133.     if density=75 then shift:=4;
  1134.     if density=150 then shift:=2;
  1135.     ii:=-1;
  1136.     ypos:=0;
  1137.     while ii<map.count-1 do begin
  1138.       ii:=ii+1;
  1139.       tt:=map[ii];
  1140.       ll:=length(tt);
  1141.       toy:=ypos+shift-1;
  1142.       for zz:=ypos to toy do begin
  1143.         with tb.canvas do begin
  1144.           xpos:=0;
  1145.           for jj:=1 to ll do begin
  1146.             if tt[jj]<>'.' then begin
  1147.               lcolor:=clBlack;
  1148.             end else begin
  1149.               lcolor:=clWhite;
  1150.             end;
  1151.             { fill in gaps with last color }
  1152.             tox:=xpos+shift-1;
  1153.             for kk:=xpos to tox do begin
  1154.               pixels[kk,zz]:=lcolor;
  1155.             end;
  1156.             xpos:=xpos+shift;
  1157.           end;
  1158.         end;
  1159.       end;
  1160.       ypos:=ypos+shift;
  1161.     end;
  1162.     fromrect:=rect(0,0,xpos,ypos);
  1163.     tb2.canvas.CopyRect(tb2.canvas.cliprect,tb.canvas,fromrect);
  1164.     aCanvas.Draw(ScaleX(left),ScaleY(top),tb2);
  1165.     map.free;
  1166.     tb.free;
  1167.     tb2.free;
  1168.   end;
  1169.   EndCommand;
  1170. end;
  1171.  
  1172. procedure Lpr.pxLine(aRect:Trect);
  1173. begin
  1174.   if Abort then Exit;
  1175.   if WantsPreview then begin
  1176.     AddCommand('21'+Dlm+
  1177.         ltrim(stri(arect.left,5))+Dlm+ltrim(stri(arect.top,5))+Dlm+
  1178.         ltrim(stri(arect.right,5))+Dlm+ltrim(stri(arect.bottom,5)));
  1179.   end else begin
  1180.     with aCanvas do begin
  1181.       { if right>bottom then horizontal line }
  1182.       if arect.right>arect.bottom then pen.width:=arect.bottom
  1183.       else pen.width:=arect.right;
  1184.       if WindowDest then pen.width:=1;
  1185.       brush.style:=bsClear;
  1186.       moveto(ScaleX(arect.left),ScaleY(arect.top));
  1187.       if arect.right>arect.bottom then  { horizontal line }
  1188.         lineto(ScaleX(arect.left+arect.right),ScaleY(arect.top))
  1189.       else                  { vertical line }
  1190.         lineto(ScaleX(arect.left),ScaleY(arect.top+arect.bottom));
  1191.     end;
  1192.   end;
  1193.     EndCommand;
  1194. end;
  1195.  
  1196. procedure Lpr.pxBox(aRect:Trect;GrayLev:integer);
  1197. begin
  1198.   if Abort then Exit;
  1199.   if WantsPreview then AddCommand('22'+Dlm+
  1200.     ltrim(stri(arect.left,5))+Dlm+ltrim(stri(arect.top,5))+Dlm+
  1201.     ltrim(stri(arect.right,5))+Dlm+ltrim(stri(arect.bottom,5))+Dlm+
  1202.     ltrim(stri(graylev,5)))
  1203.   else begin
  1204.     with aCanvas do begin
  1205.       { if i3>i4 then its a horizontal box }
  1206.       brush.style:=bsSolid;
  1207.       if graylev=0 then brush.color:=clBlack else
  1208.         if graylev=1 then brush.color:=clWhite else begin
  1209.           { must use Yellow when printing light gray on paper }
  1210.           if WindowDest then brush.color:=clAqua else brush.color:=clYellow;
  1211.         end;
  1212.       fillrect(rect(ScaleX(arect.left),ScaleY(arect.top),
  1213.         ScaleX(arect.left+arect.right),ScaleY(arect.top+arect.bottom)));
  1214.     end;
  1215.   end;
  1216.     EndCommand;
  1217. end;
  1218.  
  1219. procedure Lpr.pxOrientation(newOrientation:TPrinterOrientation);
  1220. begin
  1221.   if Abort then Exit;
  1222.   if WantsPreview then AddCommand('26'+Dlm+
  1223.       iifs(newOrientation=poPortrait,'PORTRAIT','LANDSCAPE'))
  1224.     else begin
  1225.       if Not WindowDest then begin
  1226.           pr.Orientation:=newOrientation;
  1227.       pr.fcanvas.brush.style:=bsSolid;
  1228.       pr.fcanvas.brush.color:=clWhite;
  1229.       pr.fcanvas.fillrect(pr.fcanvas.cliprect);
  1230.           aCanvas:=pr.fCanvas;
  1231.         end;
  1232.     end;
  1233.   EndCommand;
  1234. end;
  1235.  
  1236. procedure DirectToPrinter(anEscSeq:string);
  1237. var ii:integer;
  1238.     tt:pchar;
  1239.     tlp:TPrinter;
  1240. begin
  1241.   tlp:=TPrinter.create;
  1242.   tlp.printerindex:=lp.CurDest-1;
  1243.   tlp.begindoc;
  1244.   tt:=stralloc(260);
  1245.   strpcopy(tt,anEscSeq);
  1246.   ii:=Escape(tlp.handle,PASSTHROUGH,length(anEscSeq),tt,nil);
  1247.   tlp.enddoc;
  1248.   StrDispose(tt);
  1249.   tlp.free;
  1250. end;
  1251.  
  1252. procedure Lpr.pxImage(IsColor:boolean;aRect:Trect;ScrnBMP,PrintBMP:string);
  1253. var MustScale:boolean;
  1254.     tt:string;
  1255.     tim:tbitmap;
  1256.     ii,jj:integer;
  1257. begin
  1258.   if Abort then Exit;
  1259.   if WantsPreview then AddCommand('25'+Dlm+iifs(IsColor,'TRUE','FALSE')+Dlm+
  1260.     ltrim(stri(arect.left,5))+Dlm+ltrim(stri(arect.top,5))+Dlm+
  1261.     ltrim(stri(arect.right,5))+Dlm+ltrim(stri(arect.bottom,5))+Dlm+
  1262.     ScrnBMP+Dlm+PrintBMP)
  1263.   else begin
  1264.     tim:=tbitmap.create;
  1265.     ii:=ScaleX(arect.left);
  1266.     jj:=ScaleY(arect.top);
  1267.     if WindowDest then begin
  1268.           if not empty(ScrnBMP) then begin
  1269.         tim.loadfromfile(ScrnBMP);
  1270.               aCanvas.Draw(ii,jj,tim);
  1271.       end;
  1272.     end else begin
  1273.           if not empty(PrintBMP) then begin
  1274.               tim.loadfromfile(PrintBMP);
  1275.               aCanvas.Draw(ii,jj,tim);
  1276.       end;
  1277.     end;
  1278.     tim.free;
  1279.   end;
  1280.   EndCommand;
  1281. end;
  1282.  
  1283. procedure TPreview.ShowBigImage;
  1284. var tt,ll:integer;
  1285.     halfx,halfy,adjx,adjy,tx,ty:double;
  1286.     tr:trect;
  1287. begin
  1288.   if FitToScreen then begin
  1289.     image1.visible:=false;
  1290.     image2.visible:=true;
  1291.       SetButtons;
  1292.   end else begin
  1293.     image2.visible:=false;
  1294.     if FirstTimeBig then MouseWait;
  1295.     with image1 do begin
  1296.         adjx:=Gen.FullBP.width/width;
  1297.         adjy:=Gen.FullBP.height/height;
  1298.       { adjust BigX and BigY to correct relative position }
  1299.       tx:=BigX;
  1300.       ty:=BigY;
  1301.       { Scale X and Y from Image coords to Bitmap position }
  1302.       tX:=tX*adjx;
  1303.       tY:=tY*adjy;
  1304.       halfx:=width div 2;
  1305.       halfy:=height div 2;
  1306.       { set X dimensions }
  1307.             ll:=procint(strd(tX-halfx,0));
  1308.       if ll<0 then ll:=0;
  1309.       if ll>(gen.fullBP.width-width) then ll:=gen.fullBP.width-width;
  1310.       { set Y dimensions }
  1311.             tt:=procint(strd(tY-halfy,0));
  1312.       if tt<0 then tt:=0;
  1313.       if tt>(gen.fullBP.height-height) then tt:=gen.fullBP.height-height;
  1314.       tr:=rect(ll,tt,ll+width-1,tt+height-1);
  1315.           canvas.copyrect(canvas.cliprect,Gen.FullBP.canvas,tr);
  1316.       if ll>0 then button1.enabled:=true
  1317.       else button1.enabled:=false;
  1318.       if tt>0 then button3.enabled:=true
  1319.       else button3.enabled:=false;
  1320.       if ll<(gen.fullBP.width-width) then button4.enabled:=true
  1321.       else button4.enabled:=false;
  1322.       if tt<(gen.fullBP.height-height) then button2.enabled:=true
  1323.       else button2.enabled:=false;
  1324.         visible:=true;
  1325.       DoEvents;
  1326.         if FirstTimeBig then MouseGo;
  1327.       FirstTimeBig:=false;
  1328.     end;
  1329.   end;
  1330. end;
  1331.  
  1332. procedure lpr.SetCaption(toStr:string);
  1333. { call before StopDoc }
  1334. begin
  1335.   ShortTitle:=toStr;
  1336. end;
  1337.  
  1338. procedure TPreview.ShowBluePrint(aCaption,TinyBMP,FullBMP:string);
  1339. begin
  1340.   if Gen.InBluePrint then begin
  1341.     OKbox('Can Only Have One Blue Print Open At A Time');
  1342.     close;
  1343.   end else begin
  1344.         windowstate:=wsNormal;
  1345.     Gen.InBluePrint:=true;
  1346.       Zoomable:=true;
  1347.     image1.width:=613;
  1348.     image1.height:=337;
  1349.     image2.width:=613;
  1350.     image2.height:=337;
  1351.        panel1.width:=image1.width;
  1352.     label1.caption:='Move>';
  1353.        button3.caption:='&Up';
  1354.        button2.caption:='&Down';
  1355.     button1.caption:='&Left';
  1356.        button4.caption:='&Right';
  1357.     caption:=aCaption;
  1358.       FitToScreen:=true;
  1359.       Gen.TinyBP.loadfromfile(TinyBmp);
  1360.       Gen.TinyBP.monochrome:=true;
  1361.       image2.canvas.draw(0,0,Gen.TinyBP);
  1362.       Gen.FullBP.loadfromfile(FullBmp);
  1363.     FirstTimeBig:=true;
  1364.     show;
  1365.       ShowBigImage;
  1366.   end;
  1367. end;
  1368.  
  1369. procedure Lpr.pxText(aPoint:TPoint;uzFont,TheText:string);
  1370. var curcol,atline:integer;
  1371.         tt1,tt2,msg:string135;
  1372.     i1,i2:longint;
  1373. begin
  1374.   if Abort then Exit;
  1375.     with aPoint do begin
  1376.         if WantsPreview then AddCommand('24'+Dlm+
  1377.             ltrim(stri(x,5))+Dlm+ltrim(stri(y,5))+Dlm+uzfont+Dlm+thetext)
  1378.         else begin
  1379.             with aCanvas do begin
  1380.                 setGDIfont(uzfont);
  1381.                 brush.style:=bsClear;
  1382.                 wout(ScaleX(x),ScaleY(y),thetext);
  1383.             end;
  1384.         end;
  1385.     end;
  1386.     EndCommand;
  1387. end;
  1388.  
  1389. procedure Lpr.pxBarCode(aRect:Trect;Text:string);
  1390. begin
  1391.   if Abort then Exit;
  1392.   if WantsPreview then AddCommand('27'+Dlm+
  1393.     stri(arect.left,5)+Dlm+stri(arect.top,5)+Dlm+stri(arect.right,5)+Dlm+
  1394.     stri(arect.bottom,5)+Dlm+text)
  1395.   else begin
  1396.     with preview.barcode1 do begin
  1397.       style:=3;
  1398.       if WindowDest then begin
  1399.         preview.barcode1.visible:=false;
  1400.         preview.barcode1.left:=ScaleX(arect.left);
  1401.         preview.barcode1.top:=ScaleY(arect.top);
  1402.         preview.barcode1.width:=ScaleX(arect.right);
  1403.         preview.barcode1.height:=ScaleY(arect.bottom);
  1404.         preview.barcode1.visible:=true;
  1405.         caption:=text;  { caption must be last item }
  1406.       end else begin
  1407.         caption:=text;
  1408.         printerscalemode:=3;
  1409.         printerleft:=ScaleX(arect.left);
  1410.         printertop:=ScaleY(arect.top);
  1411.         printerwidth:=ScaleX(arect.right);
  1412.         printerheight:=ScaleY(arect.bottom);
  1413.         printerhdc:=acanvas.handle;
  1414.       end;
  1415.     end;
  1416.   end;
  1417.   EndCommand;
  1418. end;
  1419.  
  1420. procedure Lpr.TextFont(NewFont:string);
  1421. begin
  1422.   if Abort then Exit;
  1423.   SetTextStyle(true);
  1424.     if WantsPreview then AddCommand(' 4'+Dlm+NewFont)
  1425.   else SetGDIfont(NewFont);
  1426.     EndCommand;
  1427. end;
  1428.  
  1429. function Lpr.Cancel:integer;  { usually found in FormClose method }
  1430. var bool:boolean;
  1431. begin
  1432.   Result:=0;
  1433.   if Running then begin
  1434.     bool:=YesNoBox('Cancel Printing');
  1435.     if bool then begin
  1436.       result:=2;  { abort }
  1437.       OKBox('After ''Wait'' Clears, You May Continue');
  1438.     end else result:=1;  { continue formatting }
  1439.   end;
  1440.   CancelState:=Result;
  1441. end;
  1442.  
  1443. procedure StartLinePrinter;
  1444. var ii:integer;
  1445. begin
  1446.   Lp:=LPmain.Create;
  1447.   for ii:=1 to MaxFonts do lp.FontList[ii]:='';
  1448.   lp.FontList[1]:='Courier New';
  1449.     { from TypeCase 2001 fonts CD collection }
  1450.   lp.FontList[2]:='Corporate Mono';
  1451.   lp.FontList[3]:='Corporate Mono Bold';
  1452.   { variable width fonts are subscripts over 5 }
  1453.   lp.FontList[6]:='Arial';
  1454.   { setup local printer type }
  1455.   if pin('0012',gen.Station) then begin  { at home }
  1456.       Gen.User:='BRAD3 ';
  1457.         Lp.LoadPrinters(compath(PrnInitFile));
  1458.       Gen.User:='BRAD ';
  1459.     end else begin
  1460.     if not empty(gen.RootDir) then Lp.LoadPrinters(compath(PrnInitFile))
  1461.     else Lp.LoadPrinters(PrnInitFile);
  1462.   end;
  1463. end;
  1464.  
  1465. procedure StopLinePrinter;
  1466. var ii:integer;
  1467. begin
  1468.   PutProgIni('Printers','LastHardCopy',inttostr(lp.CurDest));
  1469.     PutProgIni('Printers','WantsPreview',iifs(lp.WantsPreview,'1','0'));
  1470.   for ii:=1 to lp.Prncnt do
  1471.         PutProgIni('Printers',lp.LptPrinters[ii].PrName,
  1472.       lp.LptPrinters[ii].Queue);
  1473.   Lp.free;
  1474. end;
  1475.  
  1476. procedure Lpr.AddCommand(CommandStr:string);
  1477. begin
  1478.   if not InsideCommand then begin
  1479.       InsideCommand:=true;
  1480.     { if using command below, "ff" in PlayBackPage S/B 3 }
  1481.     {Commands[ViewPageTot].add(stri(ViewPageTot,2)+Dlm+
  1482.       stri(Commands[ViewPageTot].count+1,3)+Dlm+CommandStr); }
  1483.  
  1484.     { if using command below, "ff" in PlayBackPage S/B 2 }
  1485.     Commands[ViewPageTot].add(stri(ViewPageTot,2)+Dlm+CommandStr);
  1486.  
  1487.     { Why 2 ways? I have a frequent short report that only takes up a half
  1488.       page, I store the results of the first in the top half, the next in
  1489.       the bottom half.  Then I use AddStrings() and Sort to merge the two
  1490.       pages before finally printing. }
  1491.     end;
  1492. end;
  1493.  
  1494. procedure Lpr.EndCommand;
  1495. begin
  1496.     InsideCommand:=false;
  1497. end;
  1498.  
  1499. procedure TPreview.LoadCommands(fromFile:string);
  1500. var LoadList:Tstringlist;
  1501.          ii,jj:integer;
  1502. begin
  1503.   LoadList:=tstringlist.create;
  1504.   LoadList.loadfromfile(fromFile);
  1505.   wPageTot:=0;
  1506.   for jj:=1 to MaxPages do begin
  1507.     if wCommands[jj]<>nil then wCommands[jj].clear;
  1508.   end;
  1509.   for jj:=0 to LoadList.Count-1 do begin
  1510.     ii:=strtoint(copy(LoadList[jj],1,2));
  1511.     if ii<1 then ii:=1;
  1512.     if wCommands[ii]=nil then wCommands[ii]:=tstringlist.create;
  1513.     wCommands[ii].Add(LoadList[jj]);
  1514.     if ii>wPageTot then wPageTot:=ii;
  1515.   end;
  1516.   LoadList.free;
  1517. end;
  1518.  
  1519. procedure TPreview.SaveCommands(toFile:string);
  1520. var SaveList:Tstringlist;
  1521.          jj:integer;
  1522. begin
  1523.   SaveList:=tstringlist.create;
  1524.   for jj:=1 to wPageTot do SaveList.AddStrings(wCommands[jj]);
  1525.   SaveList.savetofile(toFile);
  1526.   SaveList.free;
  1527. end;
  1528.  
  1529. function TPreview.PlayBackPage(ToScreen:boolean;PageNum:integer):boolean;
  1530. var lpp:Lpr;
  1531.     pcnt,opt,ii,jj,ff,start,finish:integer;
  1532.         pstr:array [1..10] of string135;
  1533.     tt,tt2:string;
  1534. begin
  1535.   { if Pagenum=0 then print all pages }
  1536.   lpp:=Lpr.Create;
  1537.   lpp.SetDestination;
  1538.   with lpp do begin
  1539.     CurDest:=wCurDest;
  1540.     WantsPreview:=false;
  1541.     WindowDest:=ToScreen;
  1542.     start:=PageNum;
  1543.     finish:=PageNum;
  1544.     if PageNum=0 then begin
  1545.         start:=1;
  1546.         finish:=wPageTot;
  1547.     end;
  1548.         if ToScreen then begin
  1549.             if empty(wShortTitle) then caption:='Preview'
  1550.                 else caption:=GetTitle(trim(wShortTitle));
  1551.       windowstate:=wsNormal;
  1552.           aCanvas:=image1.canvas;
  1553.             StartDoc2(ToScreen,wRpWide,wShortTitle);
  1554.         end else begin
  1555.             if empty(wShortTitle) then lpp.preview.caption:='Printing'
  1556.                 else lpp.preview.caption:='Printing '+trim(wShortTitle);
  1557.       lpp.useLandScape:=self.useLandScape;
  1558.           StartDoc(wRpWide,wShortTitle);
  1559.         end;
  1560.     { debug line}
  1561.     if Gen.User='BRAD ' then SaveCommands(TempPath('commands.txt'));
  1562.     for ii:=start to finish do begin
  1563.           { find first entry }
  1564.       if ToScreen then begin
  1565.           image1.canvas.brush.style:=bsSolid;
  1566.         image1.canvas.brush.color:=clWhite;
  1567.         image1.canvas.fillrect(image1.canvas.cliprect);
  1568.         image1.visible:=false;
  1569.         label2.caption:='Pg '+ltrim(stri(start,3))+
  1570.           ' of '+ltrim(stri(wPageTot,3));
  1571.         MouseWait;
  1572.       end;
  1573.             if wCommands[ii].count>0 then begin
  1574.               for jj:=0 to wCommands[ii].count-1 do begin
  1575.           doevents2;
  1576.                     split(wCommands[ii][jj],Dlm,pstr,pcnt);
  1577.           ff:=2;   { first field after page number and/or sequence no. }
  1578.                     opt:=procint(pstr[ff]);
  1579.                     case opt of
  1580.              { Row,Col style reports }
  1581.                        1:p(procint(pstr[ff+1]),procint(pstr[ff+2]),pstr[ff+3]);
  1582.                        2:SetRowCol(procint(pstr[ff+1]),procint(pstr[ff+2]));
  1583.                        3:CrLf;
  1584.                        4:TextFont(pstr[ff+1]);
  1585.              { Special Commands }
  1586.                        5:SetTextStyle(pin('TRUE',pstr[ff+1]));
  1587.                       10:DirectToPrinter(pstr[ff+1]);
  1588.                       { Raster style reports, called by above }
  1589.                       21:pxLine(Rect(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1590.                  procint(pstr[ff+3]),procint(pstr[ff+4])));
  1591.                       22:pxBox(Rect(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1592.                  procint(pstr[ff+3]),procint(pstr[ff+4])),procint(pstr[ff+5]));
  1593.                          24:pxText(Point(procint(pstr[ff+1]),procint(pstr[ff+2])),pstr[ff+3],
  1594.                  pstr[ff+4]);
  1595.                         25:begin
  1596.                  pxImage(pin('TRUE',pstr[ff+1]),Rect(procint(pstr[ff+2]),
  1597.                    procint(pstr[ff+3]),procint(pstr[ff+4]),
  1598.                    procint(pstr[ff+5])),pstr[ff+6],pstr[ff+7]);
  1599.                end;
  1600.                         26:begin
  1601.                              if pin('PORTRAIT',pstr[ff+1]) then
  1602.                                      pxOrientation(poPortrait)
  1603.                                  else
  1604.                                      pxOrientation(poLandScape);
  1605.                              end;
  1606.                         27:pxBarCode(Rect(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1607.                  procint(pstr[ff+3]),procint(pstr[ff+4])),pstr[ff+5]);
  1608.                       28:pxTray(procint(pstr[ff+1]));
  1609.             29:pxRaster(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1610.                  procint(pstr[ff+3]),procint(pstr[ff+4]),
  1611.                  procint(pstr[ff+5]),pstr[ff+6]);
  1612.                     end;
  1613.                 end;
  1614.             end else OKbox('Page '+inttostr(ii)+' Is Blank');
  1615.       { last page Eject in StopDoc }
  1616.       if ToScreen then begin
  1617.         MouseGo;
  1618.         image1.visible:=true;
  1619.       end;
  1620.             if not ToScreen and (ii<finish) then Eject;
  1621.     end;
  1622.         StopDoc;
  1623.   end;
  1624.     result:=(lpp.CancelState<>2);  { not cancelled }
  1625.   lpp.free;
  1626. end;
  1627.  
  1628. procedure TPreview.BitBtn6Click(Sender: TObject);
  1629. begin
  1630.   PlayBackPage(false,0);
  1631. end;
  1632.  
  1633. procedure TPreview.BitBtn1Click(Sender: TObject);
  1634. begin
  1635.   PlayBackPage(false,CurPage);
  1636. end;
  1637.  
  1638. procedure TPreview.Button3Click(Sender: TObject);
  1639. begin
  1640.   if zoomable then begin
  1641.     BigY:=BigY-ScrollPixels;
  1642.     if BigY<0 then BigY:=0;
  1643.     ShowBigImage;
  1644.   end else begin
  1645.       Curpage:=1;
  1646.       PlayBackPage(true,1);
  1647.       SetButtons;
  1648.   end;
  1649. end;
  1650.  
  1651. procedure TPreview.Button4Click(Sender: TObject);
  1652. begin
  1653.   if zoomable then begin
  1654.     BigX:=BigX+ScrollPixels;
  1655.     ShowBigImage;
  1656.   end else begin
  1657.       CurPage:=wPageTot;
  1658.       PlayBackPage(true,CurPage);
  1659.       SetButtons;
  1660.   end;
  1661. end;
  1662.  
  1663. procedure TPreview.Button2Click(Sender: TObject);
  1664. begin
  1665.   if zoomable then begin
  1666.     BigY:=BigY+ScrollPixels;
  1667.     ShowBigImage;
  1668.   end else begin
  1669.       if CurPage>1 then begin
  1670.         CurPage:=CurPage-1;
  1671.         PlayBackPage(true,CurPage);
  1672.           SetButtons;
  1673.       end;
  1674.   end;
  1675. end;
  1676.  
  1677. procedure TPreview.Button1Click(Sender: TObject);
  1678. begin
  1679.   if zoomable then begin
  1680.     BigX:=BigX-ScrollPixels;
  1681.     if BigX<0 then BigX:=0;
  1682.     ShowBigImage;
  1683.   end else begin
  1684.       if CurPage<wPageTot then begin
  1685.         CurPage:=CurPage+1;
  1686.         PlayBackPage(true,CurPage);
  1687.         SetButtons;
  1688.         end;
  1689.   end;
  1690. end;
  1691.  
  1692. procedure TPreview.Edit1KeyPress(Sender: TObject; var Key: Char);
  1693. var ii:integer;
  1694. begin
  1695.   if getret(key) then begin
  1696.     ii:=procint(edit1.text);
  1697.     if (ii>0) and (ii<=wPageTot) then begin
  1698.         CurPage:=ii;
  1699.         PlayBackPage(true,CurPage);
  1700.         SetButtons;
  1701.       end;
  1702.   end;
  1703. end;
  1704.  
  1705. procedure TPreview.SetButtons;
  1706. begin
  1707.   if Zoomable then begin
  1708.     button1.enabled:=not FitToScreen;
  1709.     button2.enabled:=not FitToScreen;
  1710.     button3.enabled:=not FitToScreen;
  1711.     button4.enabled:=not FitToScreen;
  1712.     { set popupmenu choices }
  1713.     Firstpg1.enabled:=false;
  1714.     Previouspg1.enabled:=false;
  1715.     bitbtn6.enabled:=false;
  1716.     gotopg1.enabled:=false;
  1717.     bitbtn1.enabled:=false;
  1718.     printall1.enabled:=false;
  1719.     printpg1.enabled:=false;
  1720.     Nextpg1.enabled:=false;
  1721.     Lastpg1.enabled:=false;
  1722.     edit1.enabled:=false;
  1723.   end else begin
  1724.     if wPageTot=1 then begin
  1725.       button1.enabled:=false;
  1726.       button2.enabled:=false;
  1727.       button3.enabled:=false;
  1728.       button4.enabled:=false;
  1729.       { set popupmenu choices }
  1730.       Firstpg1.enabled:=false;
  1731.       Previouspg1.enabled:=false;
  1732.       bitbtn6.enabled:=false;
  1733.       gotopg1.enabled:=false;
  1734.       printall1.enabled:=false;
  1735.       Nextpg1.enabled:=false;
  1736.       Lastpg1.enabled:=false;
  1737.       edit1.enabled:=false;
  1738.     end else begin
  1739.       button1.enabled:=true;
  1740.       button2.enabled:=true;
  1741.       button3.enabled:=true;
  1742.       button4.enabled:=true;
  1743.       Firstpg1.enabled:=true;
  1744.       Previouspg1.enabled:=true;
  1745.       Nextpg1.enabled:=true;
  1746.       Lastpg1.enabled:=true;
  1747.       edit1.enabled:=true;
  1748.       bitbtn6.enabled:=true;
  1749.       gotopg1.enabled:=true;
  1750.       printall1.enabled:=true;
  1751.       if CurPage=1 then begin
  1752.         button3.enabled:=false;
  1753.         button2.enabled:=false;
  1754.         Firstpg1.enabled:=false;
  1755.         Previouspg1.enabled:=false;
  1756.       end;
  1757.       if CurPage=wPageTot then begin
  1758.         button4.enabled:=false;
  1759.         button1.enabled:=false;
  1760.         Nextpg1.enabled:=false;
  1761.         Lastpg1.enabled:=false;
  1762.       end;
  1763.     end;
  1764.   end;
  1765. end;
  1766.  
  1767. procedure Lpr.ForceToScreen;
  1768. begin
  1769.   { override current print dest., force report to Report Preview }
  1770.   WantsPreview:=true;
  1771.   WindowDest:=true;
  1772. end;
  1773.  
  1774. procedure Lpr.ForceToPrinter;
  1775. begin
  1776.   { override current print dest., force report to a printer }
  1777.   WantsPreview:=false;
  1778.   WindowDest:=false;
  1779. end;
  1780.  
  1781. procedure TPreview.Close1Click(Sender: TObject);
  1782. begin
  1783.   Close;
  1784. end;
  1785.  
  1786. procedure TPreview.FirstPg1Click(Sender: TObject);
  1787. begin
  1788.   Curpage:=1;
  1789.   PlayBackPage(true,1);
  1790.   SetButtons;
  1791. end;
  1792.  
  1793. procedure TPreview.PreviousPg1Click(Sender: TObject);
  1794. begin
  1795.   if CurPage>1 then begin
  1796.     CurPage:=CurPage-1;
  1797.     PlayBackPage(true,CurPage);
  1798.       SetButtons;
  1799.   end;
  1800. end;
  1801.  
  1802. procedure TPreview.NextPg1Click(Sender: TObject);
  1803. begin
  1804.   if CurPage<wPageTot then begin
  1805.     CurPage:=CurPage+1;
  1806.     PlayBackPage(true,CurPage);
  1807.     SetButtons;
  1808.     end;
  1809. end;
  1810.  
  1811. procedure TPreview.LastPg1Click(Sender: TObject);
  1812. begin
  1813.   CurPage:=wPageTot;
  1814.   PlayBackPage(true,CurPage);
  1815.   SetButtons;
  1816. end;
  1817.  
  1818. procedure TPreview.PrintAll1Click(Sender: TObject);
  1819. begin
  1820.   PlayBackPage(false,0);
  1821. end;
  1822.  
  1823. procedure TPreview.PrintPg1Click(Sender: TObject);
  1824. begin
  1825.   PlayBackPage(false,CurPage);
  1826. end;
  1827.  
  1828. procedure LPmain.Capture(PortNum:integer;ToQueue:string);
  1829. { Code below modified from Apiary Netware Lib, file:
  1830.                   \apiary\examples\sdk\printca1.pas }
  1831. var Flags1:NWCAPTURE_FLAGS1;
  1832.         Flags2:NWCAPTURE_FLAGS2;
  1833.     Conn:NWCONN_HANDLE;
  1834.     Server,Lpt,None:array [0..50] of char;
  1835.     code:integer;
  1836. begin
  1837.   { Flag codes: $80 no banner, $40 no tab expansion, $08 no form feed }
  1838.     if (PortNum>0) and (PortNum<4) then begin
  1839.       if empty(ToQueue) then EndCapture(PortNum)
  1840.       else begin
  1841.       NWGetDefaultConnectionID(Conn);
  1842.       strpcopy(Server,upper(ToQueue));
  1843.       strpcopy(Lpt,'LPT'+inttostr(PortNum));
  1844.       strpcopy(none,'');
  1845.       EndCapture(PortNum);
  1846.       WNetAddConnection(Server,none,Lpt);
  1847.         code:=NWGetCaptureFlags(PortNum,Flags1,Flags2);
  1848.       Flags1.printFlags:=Flags1.printFlags and (not $80);
  1849.       Flags1.printFlags:=Flags1.printFlags and (not $40);
  1850.       Flags1.printFlags:=Flags1.printFlags or $08;
  1851.         code:=NWSetCaptureFlags(Conn,PortNum,Flags1);
  1852.       end;
  1853.   end;
  1854. end;
  1855.  
  1856. procedure LPmain.EndCapture(PortNum:integer);
  1857. begin
  1858.   if (PortNum>0) and (PortNum<4) then begin
  1859.     NWFlushCapture(PortNum);
  1860.     NWEndCapture(PortNum);
  1861.   end;
  1862. end;
  1863.  
  1864. procedure TPreview.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  1865.   Shift: TShiftState; X, Y: Integer);
  1866. begin
  1867.   if zoomable then begin
  1868.     FitToScreen:=not FitToScreen;
  1869.       BigX:=x;
  1870.       BigY:=Y;
  1871.       ShowBigImage;
  1872.   end;
  1873. end;
  1874.  
  1875. procedure TPreview.Image2MouseUp(Sender: TObject; Button: TMouseButton;
  1876.   Shift: TShiftState; X, Y: Integer);
  1877. begin
  1878.   if zoomable then begin
  1879.       FitToScreen:=not FitToScreen;
  1880.       BigX:=x;
  1881.       BigY:=Y;
  1882.       ShowBigImage;
  1883.   end;
  1884. end;
  1885.  
  1886. procedure TPreview.GoToPg1Click(Sender: TObject);
  1887. var ii:integer;
  1888. begin
  1889.   ii:=procint(InputBox('Go To','Page #',''));
  1890.   if (ii>0) and (ii<=wPageTot) then begin
  1891.     CurPage:=ii;
  1892.     PlayBackPage(true,CurPage);
  1893.     SetButtons;
  1894.   end;
  1895. end;
  1896.  
  1897. procedure TPreview.PrintCommandFile(aLoadSpec:string);
  1898. var ii:integer;
  1899.     tt,tt2:string;
  1900. begin
  1901.     ii:=pos('::',upper(aLoadSpec));
  1902.   if ii>0 then begin
  1903.         tt:=ltrim(trim(substr(aLoadSpec,ii+2,70)));
  1904.     wShortTitle:=aLoadSpec;
  1905.         if not FileExists(tt) then begin
  1906.       OkBox('Pre-Load File Not Found: '+tt);
  1907.       close;
  1908.         end else begin
  1909.             LoadCommands(tt);
  1910.         wCurDest:=lp.curdest;
  1911.           wShortTitle:=wCommands[1][0];
  1912.           wRpWide:=pin('for14x11',wShortTitle);
  1913.             if lp.WantsPreview then begin
  1914.                 windowstate:=wsNormal;
  1915.               PlayBackPage(true,1);  { start with page 1 }
  1916.         SetButtons;
  1917.             end else begin
  1918.                 windowstate:=wsMinimized;
  1919.               PlayBackPage(false,0);
  1920.         close;
  1921.             end;
  1922.         end;
  1923.     end;
  1924. end;
  1925.  
  1926. procedure TPreview.FormActivate(Sender: TObject);
  1927. begin
  1928.   Label5.caption:=lp.CurrentPrinterInfo;
  1929. end;
  1930.  
  1931. end.
  1932.